home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 July / Macworld (1999-07).dmg / Shareware World / Info / For Developers / Mops 3.4.sea / Mops source / Asm Source / Dictionary < prev    next >
Text File  |  1995-07-05  |  4KB  |  169 lines
  1. \ DICTIONARY CLASS                  Reese Warner                4/85
  2. \  Useful for symbol tables, et. al.
  3.  
  4. 0 -> dlevel
  5.  
  6.  
  7. :class    DICTELT  super{ string }
  8. record
  9. {    objHandle    OBJHDL    \ Handle to the object associated with the string.
  10. }
  11.  
  12. :m PUTOBJHDL:    put: objHdl  ;m
  13. :m GETOBJ:        obj: objHdl  ;m
  14. :m RELEASE:
  15.     release: super
  16.     nil?: objHdl  ?EXIT
  17.     obj: objHdl  release: **   release: objHdl  ;m
  18.  
  19. :m PRINT:    4 spaces  print: super  3 spaces  obj: objHdl  print: **  ;m
  20.  
  21. ;class
  22.  
  23.  
  24. objPtr    HLOBJ    class_is  handleList
  25. objPtr    DEOBJ    class_is  dictElt
  26.  
  27.  
  28. :class    DICTIONARY  super{ handleArray }
  29.  
  30. private
  31.  
  32. \ SEARCHLIST - does the main work of methods ENTER & QUERY. Intended to be
  33. \   a private method for class DICTIONARY. Searchs the handleList object
  34. \   HLobj for a dictElt object matching the given string.  If found, returns
  35. \   the matching dictElt object and true, otherwise just false.
  36.  
  37. :m SEARCHLIST:   { HLob strObj -- DEobj T  |  -- F }
  38.     HLob -> HLobj
  39.     BEGIN  each: HLobj
  40.     WHILE
  41.         ( obj addr )  -> DEobj
  42.         get: [ strObj ]  get: DEobj  s=
  43.         IF  unEach: HLobj  DEobj true  EXIT  THEN
  44.     REPEAT
  45.     false  ;m
  46.  
  47. public
  48.  
  49. \ QUERY - returns pointer to the object associated with strObj in the
  50. \ dictionary.  If string is not found, then nilP is returned.
  51.  
  52. :m QUERY:   { strObj \ idx -- ^obj }
  53.  
  54.     get: [ strObj ] str255  wHash  limit: self  mod  -> idx
  55.     idx  select: self
  56.     nil?: self  IF  nilP  EXIT  THEN
  57.     obj: self  -> HLobj
  58.     size: HLobj  NIF  nilP  EXIT  THEN
  59.     HLobj strObj searchList: self
  60.     IF
  61.         -> DEobj
  62.         getObj: DEobj
  63.     ELSE
  64.         nilP
  65.     THEN
  66.     unlock: self  ;m
  67.  
  68.  
  69. \ ENTER - puts the string and value into the dictionary. If the string is
  70. \  already in the dictionary then it changes the value to the new value.
  71.  
  72. :m ENTER:  { hdlObj strObj \ idx -- }
  73.  
  74.     get: [ strObj ]  str255  wHash  limit: super  mod -> idx
  75.     idx  select: self
  76.     nil?: self
  77.     IF  ( Need new handleList object )
  78.         ['] handleList  newObj: self    obj: self  -> HLobj
  79.         ['] dictElt  newObj: HLobj    obj: HLobj -> DEobj
  80.         strObj ->: DEobj
  81.         get: [ hdlObj ]  putObjHdl: DEobj
  82.     ELSE
  83.         obj: self  -> HLobj
  84.         HLobj strObj searchList: self
  85.         IF  ( In already - change value )
  86.             -> DEobj
  87.             get: [ hdlObj ]  putObjHdl: DEobj
  88.         ELSE
  89.             ['] dictElt  newObj: HLobj
  90.             obj: HLobj -> DEobj
  91.             strObj ->: DEobj
  92.             get: [ hdlObj ]  putObjHdl: DEobj
  93.         THEN
  94.     THEN
  95.     unlock: HLobj  unlock: self  ;m
  96.  
  97.  
  98. \ EXEC: - for every element in the dictionary exec: executes routine with the 
  99. \  associated value and an addr/len pair representing the hashed string as 
  100. \  an argument
  101.  
  102. \ :m EXEC:  { routine -- }
  103. \    limit: self 0 
  104. \    DO
  105. \        i  select: self
  106. \        nil?: self
  107. \        NIF
  108. \            obj: self  -> HLobj
  109. \            start: HLobj
  110. \            BEGIN
  111. \                obj: HLobj  -> DEobj
  112. \                getObj: DEobj  get: DEobj
  113. \                routine  execute
  114. \                unlock: HLobj
  115. \                next?: HLobj
  116. \            NUNTIL
  117. \            unlock: self
  118. \        THEN
  119. \    LOOP  ;m
  120.  
  121.  
  122. :m RELEASE:
  123.     release: super  limit  put: size  ;m
  124.  
  125. :m CLASSINIT:
  126.     limit  put: size
  127.     classinit: super  ;m
  128.  
  129. ;class
  130.  
  131. 25    dictionary    SYMTAB
  132.  
  133. endload
  134.  
  135. \ Testing
  136. +echo
  137.  
  138. 10 dictionary dd
  139. string s  " hello" put: s  string t  " qqq" put: t
  140. handle h
  141.  
  142. ' var  newObj: h
  143. \ h s enter: dd
  144.  
  145. endload
  146.  
  147. :class    SYMBOLS        super(    dictionary  )
  148.  
  149. \ QUERY - returns value associated with String in dictionary and FoundFlag. If
  150. \ string is not found in dictionary, then 0 0 is returned. Needed for SymTab
  151. \ where 0 is valid value.
  152.  
  153. :m QUERY:   { strObj \ idx HLobj DEobj -- val b }
  154.  
  155.     get: strObj str255  wHash  limit: self  mod  -> idx
  156.     idx  select: self
  157.     nil?: self  IF  0  false  EXIT  THEN
  158.     obj: self  -> HLobj
  159.     size: HLobj  NIF  0  false  EXIT  THEN
  160.     HLobj strObj searchList: self
  161.     IF
  162.         -> DEobj
  163.         getData: DEobj  true
  164.     ELSE
  165.         0  false
  166.     THEN  ;m
  167.  
  168. ;class
  169.